home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / sedit.tcl.z / sedit.tcl
Text File  |  2002-07-08  |  21KB  |  729 lines
  1. # sedit
  2. #
  3. # A simple editor for composing mail messages.
  4. # See also the Text and Entry bindings in seditBind.tcl
  5. #
  6. # Copyright (c) 1993 Xerox Corporation.
  7. # Use and copying of this software and preparation of derivative works based
  8. # upon this software are permitted. Any distribution of this software or
  9. # derivative works must comply with all applicable United States export
  10. # control laws. This software is made available AS IS, and Xerox Corporation
  11. # makes no warranty about the software, its performance or its conformity to
  12. # any specification.
  13.  
  14. proc SeditHelp {} {
  15.     Help Sedit "Simple Editor Help"
  16. }
  17. proc SeditId { draft } {
  18.     global mhProfile
  19.     if [regsub ^$mhProfile(path)/$mhProfile(draft-folder)/ $draft {} newdraft] {
  20.     return $newdraft
  21.     } else {
  22.     set newdraft $draft    ;# TCL 7.0 bug
  23.     regsub ^$mhProfile(path)/ $draft {} newdraft
  24.     regsub -all {\.} $newdraft _ newdraft
  25.     return $newdraft
  26.     }
  27. }
  28. proc SeditProperSigfileDefault {} {
  29.     global sedit
  30.     if {[string length $sedit(sigfileDefault)] == 0} {
  31.     set sedit(sigfileDefault) ~/.signature
  32.     }
  33.     if ![regexp {^[/~]} $sedit(sigfileDefault)] {
  34.     set sedit(sigfileDefault) ~/$sedit(sigfileDefault)
  35.     }
  36.     return [glob -nocomplain $sedit(sigfileDefault)]
  37. }
  38. proc SeditSigfileDefault {} {
  39.     global intelligentSign
  40.     set propersig [SeditProperSigfileDefault]
  41.     if {$intelligentSign(state)} {
  42.     return {///auto///}
  43.     }
  44.     return $propersig
  45. }
  46. proc Sedit_Start { draft } {
  47.     global sedit intelligentSign quote msg pgp
  48.     global exmh    ;# for menu references to $exmh(...)
  49.     if ![info exists sedit(init)] {
  50.     Sedit_Init
  51.     }
  52.     if ![info exists sedit(checkpoint)] {
  53.     SeditPeriodicSave
  54.     }
  55.     set id [SeditId $draft]
  56.     set b .sedit${id}.but
  57.     if {[Exwin_Toplevel .sedit$id $draft Sedit] == 0} {
  58.     # Reuse existing window
  59.     set t $sedit($id,text)
  60.     SeditMsg $t $draft
  61.     $t delete 1.0 end
  62.     .sedit$id.but.send config -state normal
  63.     set sedit($t,sigfile) [SeditSigfileDefault]
  64.     EditMaybeAddPhrasePane $id .sedit$id
  65.     } else {
  66.     wm iconname .sedit$id draft/$id
  67.     set f [Widget_Frame .sedit$id f Frame {top expand fill}]
  68.     set t [Widget_Text $f $sedit(height) -setgrid true -wrap char]
  69.  
  70.     Drop_Attach $t SeditDragDrop
  71.  
  72.     # PGP version-setting moved out from seditpgp code
  73.      if {$pgp(enabled)} {
  74.          if {![info exists pgp($pgp(version,$id),myname,$id)]} {
  75.          set pgp($pgp(version,$id),myname,$id) $pgp($pgp(version,$id),myname)
  76.          }
  77.          EditMaybeAddPhrasePane $id .sedit$id
  78.      }
  79.  
  80.     set sedit($t,status) [Widget_Entry .sedit${id} status {top fill} -relief raised]
  81.  
  82.     # Nuke the Dismiss button because the Abort, Send, and Save&Quit
  83.     # buttons pretty much cover the gamut
  84.     set cmd [option get .sedit$id.but.quit command {}]
  85.     if {[string length $cmd] == 0} {
  86.         set cmd [list SeditQuit $draft $t]
  87.     } else {
  88.         set cmd [subst $cmd]
  89.     }
  90.     destroy $b.quit
  91.     wm protocol .sedit$id WM_DELETE_WINDOW $cmd
  92.  
  93.     # Send has command defined by app-defaults, but we
  94.     # need to fix it up with an eval here
  95.     Widget_AddButDef $b send 
  96.     pack [frame $b.sendpad -width 6 -height 1] -side right -fill y
  97.     Widget_ReEvalCmd $b.send    ;# expand variables now
  98.  
  99.     if [catch {glob ~/.signature*} sigFiles1] {
  100.         set sigFiles1 [glob ~]/.signature
  101.     }
  102.     set sigFiles {}
  103.     foreach sig $sigFiles1 {
  104.         if {! [string match *~ $sig]} {
  105.         lappend sigFiles $sig
  106.         }
  107.     }
  108.     set sedit($t,sigfile) [SeditSigfileDefault]
  109.     set sigFiles [lsort $sigFiles]
  110.     if {([llength $sigFiles] <= 1) && !$sedit(autoSign)} {
  111.         Widget_AddButDef $b sign
  112.         Widget_ReEvalCmd $b.sign
  113.         # Fix up third argument to SeditSign
  114.         if {[string length $sigFiles] != 0} {
  115.         set cmd [lindex [$b.sign config -command] 4]
  116.         lappend cmd $sigFiles
  117.         $b.sign config -command $cmd
  118.         }
  119.     } else {
  120.         set menu [Widget_AddMenuBDef $b sign {right padx 1 filly}]
  121.         # Expand variables in the command
  122.         set cmd [subst [option get $b.sign command {}]]
  123.         set txt [option get $b.sign text {}]
  124.         if ![string match *... $txt] {
  125.         $b.sign config -text $txt...
  126.         }
  127.         if {$sedit(autoSign)} {
  128.         Widget_RadioMenuItem $menu "(none)" { } sedit($t,sigfile) {}
  129.         Widget_RadioMenuItem $menu "(intelligent)" { } sedit($t,sigfile) {///auto///}
  130.         $menu add separator
  131.         set i 1
  132.         } else {
  133.         set i -1
  134.         }
  135.         foreach file $sigFiles {
  136.         if {$sedit(autoSign)} {
  137.             incr i
  138.             Widget_RadioMenuItem $menu [file tail $file] { } sedit($t,sigfile) $file
  139.         } else {
  140.             # Carefully add the signature file name to the command
  141.             set newcmd $cmd
  142.             lappend newcmd $file
  143.             Widget_AddMenuItem $menu [file tail $file] $newcmd
  144.         }
  145.         }
  146.     }
  147.     foreach but [Widget_GetButDef $b] {
  148.         if {[regexp (abort|save) $but]} {
  149.         Widget_AddButDef $b $but {left padx 5 filly}
  150.         } else {
  151.         Widget_AddButDef $b $but {right padx 1 filly}
  152.         }
  153.         Widget_ReEvalCmd $b.$but    ;# expand variables now
  154.     }
  155.  
  156.     foreach M [Widget_GetMenuBDef .sedit$id.but] {
  157.         global pgp
  158.         if {$pgp(enabled) || ($M != "pgp")} {
  159.         set menu [Widget_AddMenuBDef .sedit$id.but $M {right padx 1 filly}]
  160.         #
  161.         # Here is another way to set context for the menu commands.
  162.         # Jam the draft and text widget name into a global that
  163.         # can be accessed by the menu-invoked commands.
  164.         #
  165.         $menu config -postcommand [list SeditSetContext $draft $t]
  166.         ButtonMenuInner $menu
  167.         }
  168.     }
  169.     SeditMsg $t $draft
  170.  
  171.     # Make sure only valid entries are enabled in version submenu
  172.     # otherwise things will crash when we try submenu command.
  173.     # We don't have to take care of the active entry since 
  174.     # preferences only allows valid entries as initial version
  175.     if {$pgp(enabled)} {
  176.         set submenu $b.pgp.m.version
  177.         for {set sm 0} {$sm<=[$submenu index last]} {incr sm} {
  178.         if [catch {$submenu entrycget $sm -command} cmd] {
  179.             continue
  180.         }
  181.         if {[regexp {Pgp_SetSeditPgpVersion *([^ ]+)} $cmd {} v] && \
  182.             [info exists pgp($v,enabled)] && \
  183.             !$pgp($v,enabled) } {
  184.             $submenu entryconfigure $sm -state disabled
  185.         }
  186.         }
  187.     }
  188.  
  189.     # Define a bunch of maps among things
  190.     set sedit($t,toplevel) .sedit$id
  191.     set sedit($id,text) $t
  192.     set sedit($t,id) $id
  193.     lappend sedit(allids) .sedit$id
  194.     set sedit(.sedit$id,draft) $draft
  195.     set sedit(.sedit$id,id) $id
  196.     }
  197.     focus $t
  198.  
  199.     SeditTextBindings $draft $t        ;# set up sendMsg binding
  200.     if [file readable $quote(filename)] {
  201.         $b.repl configure -state normal
  202.         $b.repl.m entryconfigure 1 -command \
  203.          [list SeditInsertFile $draft $t $quote(filename)]
  204.         $b.repl.m entryconfigure 2 -command \
  205.          [list SeditAttachQuotedMessage $draft $t $msg(path)]
  206.     } else {
  207.     $b.repl configure -state disabled
  208.     }
  209.     set sedit($t,keep) $sedit(keepDefault)
  210.     set sedit($t,mhn) $sedit(mhnDefault)
  211.     set sedit($t,format) $sedit(formatChoice)
  212.     switch $sedit($t,format) {
  213.     OnType    {$t config -wrap char}
  214.     OnSend    {$t config -wrap word}
  215.     Never    {$t config -wrap none}
  216.     }
  217.     switch -- $sedit(quoteDefault) {
  218.     always    { set sedit($t,quote) 1 }
  219.     never    { set sedit($t,quote) 0 }
  220.     default { set sedit($t,quote) -1 }
  221.     }
  222.     set sedit($t,8bit) 0
  223.     set sedit($t,sent) 0
  224.     set sedit($t,dirty) 0
  225.     set sedit($t,encoding) {}
  226.     set sedit($t,Acharset) {}    ;# for iso-2022-jp - see SeditKinput_start
  227.     set sedit(t) $t    ;# ugly state hack
  228.  
  229.     if {0} {
  230.     # action was not being set for comp operations
  231.     if {! [info exists exmh($id,action)]} {
  232.         # If someone cares to figure out how this happens, that would be nice.
  233.         # It might happen after a send error.
  234.         Exmh_Debug "Set action for $id"
  235.         set exmh($id,action) {}
  236.     }
  237.     }
  238.     SeditMimeReset $t
  239.     if [catch {open $draft r} in] {
  240.     $t insert 1.0 "Cannot open $draft"
  241.     } else {
  242.     $t insert 1.0 [read $in]
  243.     close $in
  244.     SeditPositionCursor $t
  245.     }
  246.     SeditSetIsigHeaders $t "$id,action"
  247.     SeditMimeParse $t
  248.     if {$sedit(iso)} {
  249.     SeditInitMimeType $draft $t
  250.     }
  251.     if {$sedit(useFilter)} {
  252.     SeditShellCreate $t
  253.     } else {
  254.     set shell_parent [winfo parent [winfo parent $t]]
  255.     catch { destroy $shell_parent.jkf }
  256.     }
  257.     foreach cmd [info commands Hook_SeditInit*] {
  258.     if [catch {$cmd $draft $t} err] {
  259.         SeditMsg $t "$cmd $err"
  260.     }
  261.     }
  262. }
  263.  
  264. proc SeditBeautify { t } {
  265.     Msg_HighlightInit $t
  266.     set start [$t index "header + 1 line"]
  267.     set end   [$t index end]
  268.     Msg_TextHighlight $t $start $end
  269. }
  270.  
  271. proc SeditSetContext { draft t } {
  272.     # Called when menus are posted to set the context for some commands
  273.     global sedit
  274.     set sedit(draft) $draft
  275.     set sedit(t) $t
  276.     Exmh_Status "Sedit $t [file tail $draft]"
  277. }
  278. proc SeditPositionCursor { t } {
  279.     global sedit
  280.     # Position cursor when the draft is first open.
  281.     # Either on the first blank header line, or the first line of the message.
  282.     # Body tag is assigned to the body and is used later when/if
  283.     # composing MIME multipart messages.
  284.     set l 1
  285.     set insert 0    ;# insert mark set
  286.     set header 0    ;# header insert mark set (new headers go here)
  287.     set hlimit 0    ;# header limit mark set (cannto do richtext here)
  288.     set sedit($t,dash) 0
  289.     for {set l 1} {1} {incr l} {
  290.     if {[$t compare $l.0 > end]} {
  291.         if {! $insert} {
  292.         $t mark set insert end
  293.         }
  294.         if {! $header} {
  295.         $t mark set hlimit $l.end
  296.         $t mark gravity hlimit left
  297.         if {$l > 1} {incr l -1}
  298.         $t mark set header $l.end
  299.         }
  300.         $t tag add Body "header +1c" end
  301.         return
  302.     }
  303.     set line [$t get $l.0 $l.end]
  304.     if [regexp {^[^ X].*: *$} $line] {
  305.         if {! $insert} {
  306.         $t mark set insert $l.end
  307.         set insert 1
  308.         }
  309.     }
  310.     if {[regexp {^--} $line]} {
  311.         set sedit($t,dash) 1
  312.         set line {}
  313.     }
  314.     if {[string length $line] == 0} {
  315.         # hlimit is used for <Tab> control
  316.         # header is used to insert new header information
  317.         $t mark set hlimit $l.end
  318.         $t mark gravity hlimit left
  319.         if {$l > 1} {incr l -1}
  320.         $t mark set header $l.end
  321.         if {! $insert} {
  322.         incr l 2
  323.         $t mark set insert $l.0
  324.         }
  325.         $t tag add Body "header +1c" end
  326.         return
  327.     }
  328.     }
  329. }
  330.  
  331. proc SeditQuit { draft t } {
  332.     global sedit
  333.     if [SeditIsDirty $t] {
  334.     catch {destroy $t.seditDirty}
  335.     set f [frame $t.seditDirty -class Dialog -bd 4 -relief raised]
  336.     Widget_Message $f msg  -aspect 1000 -text "
  337. $draft
  338. has not been saved or sent.
  339. Do you want to abort (destroy) it,
  340. send it now,
  341. save it for later editting,
  342. or do nothing?"
  343.     Widget_Frame $f f Dialog
  344.     $f.f configure -bd 10
  345.     Widget_AddBut $f.f ok "Abort" [list SeditAbortDirect $draft $t]
  346.     Widget_AddBut $f.f send "Send\n(Ctrl-c)" [list SeditSend $draft $t 0]
  347.     Widget_AddBut $f.f save "Save\n(Ctrl-s)" \
  348.         [list SeditSave $draft $t SeditNuke]
  349.     Widget_AddBut $f.f no "Do nothing\n(Return)" [list destroy $f]
  350.     bind $f.f <Return>    "$f.f.no   flash ; $f.f.no   invoke"
  351.     bind $f.f <Control-c> "$f.f.send  flash ; $f.f.send  invoke"
  352.     bind $f.f <Control-s> "$f.f.save flash ; $f.f.save invoke"
  353.     Widget_PlaceDialog $t $f
  354.     focus $f.f
  355.     } else {
  356.     SeditNuke $draft $t
  357.     }
  358. }
  359. proc SeditAbortDirect { draft t } {
  360.     global mhProfile
  361.     set id [SeditId $draft]
  362.     if [regexp -- $mhProfile(draft-folder)/\[0-9\]+$ $draft] {
  363.     Edit_Done abort $id    ;# Nuke (rm) draft message
  364.     }
  365.     SeditNuke $draft $t
  366. }
  367. proc SeditAbort { draft t } {
  368.     global sedit
  369.     if [catch {frame $t.abort -bd 4 -relief ridge -class Dialog} f] {
  370.     # dialog already up
  371.     SeditAbortConfirm $t.abort $t abort
  372.     return
  373.     }
  374.     Widget_Message $f msg -aspect 1000 -text "
  375. Really ABORT?
  376. Draft will be destroyed.
  377. You might prefer Save&Quit."
  378.     pack $f.msg -padx 10 -pady 10
  379.     frame $f.but -bd 10 -relief flat
  380.     pack $f.but -expand true -fill both
  381.     set sedit($t,abort) nop
  382.     Widget_AddBut $f.but ok "Abort\n(Return)" [list SeditAbortConfirm $f $t abort] {left filly}
  383.     Widget_AddBut $f.but save "Save&Quit\n(Ctrl-s)" [list SeditAbortConfirm $f $t save] {left filly}
  384.     Widget_AddBut $f.but nop "Do Nothing\n(Ctrl-c)" [list SeditAbortConfirm $f $t nop] {right filly}
  385.     bind $f.but <Return>    "$f.but.ok   flash ; $f.but.ok   invoke"
  386.     bind $f.but <Control-c> "$f.but.nop  flash ; $f.but.nop  invoke"
  387.     bind $f.but <Control-s> "$f.but.save flash ; $f.but.save invoke"
  388.     Widget_PlaceDialog $t $f
  389.     focus $f.but
  390.     tkwait window $f
  391.     switch $sedit($t,abort) {
  392.     abort {SeditAbortDirect $draft $t}
  393.     save  {SeditSave $draft $t SeditNuke}
  394.     default { focus $t }
  395.     }
  396. }
  397. proc SeditAbortConfirm { f t yes } {
  398.     global sedit
  399.     set sedit($t,abort) $yes
  400.     destroy $f
  401. }
  402. proc SeditNuke { draft t } {
  403.     global sedit
  404.     SeditMarkClean $t
  405.     catch {destroy .seditUnsent}
  406.     catch {destroy $t.seditDirty}
  407.     catch {destroy $sedit($t,toplevel).whom}
  408.     catch {destroy $sedit($t,toplevel).spell}
  409.     update idletasks
  410.     Exwin_Dismiss $sedit($t,toplevel)
  411. }
  412. proc SeditMsg { t text } {
  413.     # Status line message output
  414.     global sedit
  415.     $sedit($t,status) configure -state normal
  416.     $sedit($t,status) delete 0 end
  417.     $sedit($t,status) insert 0 $text
  418.     $sedit($t,status) configure -state disabled
  419.     update idletasks
  420. }
  421.  
  422. proc SeditSendCommon { draft t {post 0} } {
  423.     global sedit exmh intelligentSign editor
  424.  
  425.     set id [SeditId $draft]
  426.     SeditCheckForIsigHeaders $t
  427.     Exmh_Debug SeditSend id=$id action=$exmh($id,action)
  428.     if {$sedit(autoSign) && ($sedit($t,sigfile) != "") &&
  429.     ([string compare $exmh($id,action) "dist"] != 0)} {
  430.     set b .sedit${id}.but
  431.     set cmd [subst [option get $b.sign command {}]]
  432.     if {[string length $cmd] == 0} {
  433.         Exmh_Debug SeditSend null cmd for $b.sign
  434.         set cmd {SeditSign $draft $t}
  435.     }
  436.     if {[string compare $sedit($t,sigfile) {///auto///}] == 0} {
  437.         SeditSignIntelligent $draft $t [SeditProperSigfileDefault]
  438.     } else {
  439.         eval $cmd $sedit($t,sigfile)
  440.     }
  441.     }
  442.     foreach cmd [info commands Hook_SeditSave*] {
  443.     if [catch {$cmd $draft $t} err] {
  444.         SeditMsg $t "$cmd $err"
  445.     }
  446.     }
  447.     if {$sedit($t,mhn)} {
  448.     SeditFixupMhn $draft $t
  449.     }
  450.     if {$sedit(iso)} {
  451.     SeditFixupCharset $draft $t
  452.     }
  453.     if [SeditSave $draft $t {} 0] {
  454.     global env sedit
  455.     if {$post==0} {
  456.         $sedit($t,toplevel).but.send config -state disabled
  457.     } else {
  458.         $sedit($t,toplevel).but.post config -state disabled
  459.     }
  460.     # Decide if this file needs to go through mhn
  461.     if {$sedit($t,mhn) && ![catch {exec grep -l ^# $draft}]} {
  462.         set env(mhdraft) $draft
  463.         SeditMsg $t "Running mhn..."
  464.         if [catch {exec $editor(mhn) $draft} err] {
  465.         SeditMsg $t $err
  466.         if {$post==0} {
  467.             $sedit($t,toplevel).but.send config -state normal
  468.         } else {
  469.             $sedit($t,toplevel).but.post config -state normal
  470.         }
  471.         return
  472.         }
  473.     }
  474.     if {$sedit($t,8bit)} {
  475.         # Turn on automatic quoting if we've entered 8-bit characters.
  476.         if {$sedit($t,quote) < 0} {
  477.         set sedit($t,quote) 1
  478.         }
  479.     }
  480.     if {$sedit($t,8bit) || ($sedit($t,quote) > 0)} {
  481.         # Insert content-transfer-encoding headers
  482.         SeditFixupEncoding $draft $t [expr ($sedit($t,quote) > 0)]
  483.     }
  484.     return 1
  485.     } else {
  486.     return 0
  487.     }
  488. }
  489.  
  490. proc SeditSendOnly { draft t } {
  491.     global sedit exmh
  492.  
  493.     set id [SeditId $draft]
  494.     foreach cmd [info commands Hook_SeditSend*] {
  495.         if [catch {$cmd $draft $t} err] {
  496.         SeditMsg $t "$cmd $err"
  497.         $sedit($t,toplevel).but.send config -state normal
  498.         return
  499.         }
  500.     }
  501.     # Keep on send hack
  502.     global mhProfile
  503.     set async $mhProfile(sendType)
  504.     if {$sedit($t,keep)} {
  505.         if {$async == "async"} {
  506.         set mhProfile(sendType) "wait"
  507.         }
  508.             set action $exmh($id,action)
  509.     }
  510.     SeditMsg $t "Sending message..."
  511.     SeditMarkSent $t
  512.     set time [time [list Edit_Done send $id]]
  513.     Exmh_Debug Message sent $time
  514.     SeditMsg $t "Message sent $time"
  515.     global sedit
  516.     if {! $sedit($t,keep)} {
  517.         SeditNuke $draft $t
  518.     } else {
  519.             set exmh($id,action) $action
  520.         SeditSave $draft $t        ;# Restore draft deleted by MH
  521.         set mhProfile(sendasync) $async
  522.         $sedit($t,toplevel).but.send config -state normal
  523.         if {[string compare $exmh(folder) $mhProfile(draft-folder)] == 0} {
  524.         Scan_Folder $exmh(folder)
  525.         }
  526.         SeditMsg $t "Message saved and sent $time"
  527.     }
  528. }
  529.  
  530. proc SeditSend { draft t {post 0} } {
  531.     global sedit exmh intelligentSign editor msg
  532.  
  533.     set common [SeditSendCommon $draft $t $post]
  534.  
  535.     if {$common==1} {
  536.     if {$post==0} {
  537.         SeditSendOnly $draft $t
  538.     } else {
  539.         set msg(path) $draft
  540.         Post
  541.         $sedit($t,toplevel).but.post config -state normal
  542.     }
  543.     }
  544. }
  545.  
  546. proc SeditSave { draft t {hook {}} {isigw 1} } {
  547.     global sedit mhProfile exmh
  548.     if [catch {
  549.     SeditMsg $t "Saving message..."
  550.     set out [open $draft w]
  551.     if {([string compare $sedit($t,format) "Never"] != 0)} {
  552.         SeditFormatMail $t $out $isigw
  553.     } else {
  554.         # Prevent duplicate X-Mailer or X-Exmh-Isig-* headers
  555.         set id $sedit($t,id)
  556.         SeditCheckForIsigHeaders $t
  557.         if {[catch {set end [$t index hlimit]}] &&
  558.         [catch {set end [$t index header]}]} {
  559.             set end end
  560.         }
  561.         set X1 [$t get 1.0 $end]
  562.         set X2 [$t get $end end]
  563.         regsub -all -nocase "(^|\n)(x-mailer:\[^\n\]*\n)+" $X1 {\1} X1
  564.         regsub -all -nocase "(^|\n)(x-exmh-isig-(comptype|folder):\[^\n\]*\n)+" $X1 {\1} X1
  565.         # No X-Mailer on redistributed messages
  566.         if {[string compare $exmh($id,action) dist] != 0} {
  567.         puts $out "X-Mailer: exmh $exmh(version) with $exmh(mh_vers)"
  568.         }
  569.         # Replace X-Exmh-Isig-* headers if necessary
  570.         if {$isigw} {
  571.         puts $out "X-Exmh-Isig-CompType: $sedit($t,isigc)"
  572.         puts $out "X-Exmh-Isig-Folder: $sedit($t,isigf)"
  573.         }
  574.         puts -nonewline $out "$X1$X2"
  575.     }
  576.     close $out
  577.     SeditMsg $t "Message saved"
  578.     if ![regexp -- $mhProfile(draft-folder)/\[0-9\]+$ $draft] {
  579.         # Not from the drafts folder - see if we need to update
  580.         # the main display.
  581.         Msg_Redisplay $draft
  582.     }
  583.     if {$hook != {}} {
  584.         after 1 [list $hook $draft $t]
  585.     }
  586.     } err] {
  587.     global errorInfo
  588.     error "SeditSave $draft: $err" $errorInfo
  589.     return 0
  590.     }
  591.     SeditMarkClean $t
  592.     return 1
  593. }
  594. proc SeditAlternate { draft t } {
  595.     SeditSave $draft $t SeditNuke
  596.     Edit_Done alternate [SeditId $draft]
  597. }
  598. proc SeditSaveBody { t outfile } {
  599.     set out [open $outfile w 0600]
  600.     puts -nonewline $out [$t get [$t index "header + 1 line"] end]
  601.     close $out
  602. }
  603.  
  604. proc SeditReplaceBody { t infile } {
  605.     set in [open $infile]
  606.     set tags [$t tag names "header + 1 line"]
  607.     $t delete "header + 1 line" end
  608.     $t insert end [read $in] $tags
  609.     close $in
  610.     SeditMimeParse $t    ;# Reconstruct formatting state
  611. }
  612.  
  613. proc SeditMarkSent { t } {
  614.     global sedit
  615.     set sedit($t,sent) 1
  616. }
  617. proc SeditNotSent { t } {
  618.     global sedit
  619.     return [expr {! $sedit($t,sent)}]
  620. }
  621.  
  622. proc Sedit_CheckPoint {} {
  623.     global sedit
  624.     foreach top $sedit(allids) {
  625.     if [info exists sedit($top,id)] {
  626.         set draft $sedit($top,draft)
  627.         set id $sedit($top,id)
  628.         set t $sedit($id,text)
  629.         if [SeditIsDirty $t] {
  630.         Exmh_Status "Saving draft $id"
  631.         SeditSave $draft $t
  632.         }
  633.     }
  634.     }
  635. }
  636. proc SeditPeriodicSave {} {
  637.     global sedit
  638.     if { [info exists sedit(autosaveInterval)] && $sedit(autosaveInterval) > 0 } {
  639.         Sedit_CheckPoint
  640.         set sedit(checkpoint) [after [expr 1000 * $sedit(autosaveInterval) ] SeditPeriodicSave]
  641.     }
  642. }
  643.  
  644. proc SeditFixupMhn { draft t } {
  645.     global sedit
  646.     set state header
  647.     set mhn 0
  648.     set lines {}
  649.     Exmh_Debug SeditFixupMhn
  650.     for {set i 1} {[$t compare $i.0 < end]} {incr i} {
  651.     set line [$t get $i.0 $i.end]
  652.     set len [string length $line]
  653.     if {$state == "header"} {
  654.         if [regexp -nocase {^(content-type|mime-version|content-transfer-encoding):} $line match type] {
  655.         lappend lines $i
  656.         }
  657.         if [regexp {^(--+.*--+)?$} $line] {
  658.         set state body
  659.         }
  660.     } else {
  661.         if [regexp ^# $line] {
  662.         set mhn 1
  663.         }
  664.     }
  665.     }
  666.     if {$mhn} {
  667.     if [llength $lines] {
  668.         SeditMsg $t "Cleaning up for MHN"
  669.     }
  670.     foreach i [lsort -integer -decreasing $lines] {
  671.         $t delete $i.0 "$i.end +1 char"
  672.     }
  673.     set sedit($t,8bit) 0    ;# Let MHN do quote-printable
  674.     set sedit($t,quote) 0
  675.     }
  676. }
  677.  
  678. proc SeditDragDrop { w args } {
  679.     set t [winfo toplevel $w].f.t
  680.  
  681.     global dragging
  682.     if [info exists dragging(data,folder)] {
  683.         set folder $dragging(data,folder)
  684.     SeditSetHeader $t fcc $folder
  685.     } elseif [info exists dragging(text)] {
  686.     $t insert insert $dragging(text)
  687.     }
  688. }
  689.  
  690. # Set/Replace/Append a message header
  691. # (does not handle duplicate headers)
  692. proc SeditSetHeader { t key value {append NO}} {
  693.     if [string match NO $append] {
  694.     unset append
  695.     }
  696.  
  697.     # let the text widget search for the header
  698.     set start [$t search -nocase -regexp ^${key}: 1.0 header]
  699.  
  700.     if {[string compare "" $start]} {
  701.     # find the end of the header, looking past any continuation lines
  702.     set end [$t search -regexp {^[^     ]} "$start + 1 line" header]
  703.  
  704.     # in case user mangled the header.
  705.         if {[string match "" $end]} {
  706.             set end "$start +1 line"
  707.         }
  708.  
  709.     # if we are appending, do it now.
  710.     if [info exists append] {
  711.         $t insert "$end -1c" "$append$value"
  712.         return
  713.     }
  714.  
  715.     # otherwise, delete the whole header to set up for insertion.
  716.     $t delete $start $end
  717.     } else {
  718.     # insert a new header near the end of the headers
  719.     set start "header linestart"
  720.     }
  721.  
  722.     # insert the new/replaced header
  723.     $t insert $start "[string toupper [string index $key 0]][string tolower [string range $key 1 end]]: $value\n"
  724. #    $t tag remove Charset $start "$start lineend"
  725. }
  726.  
  727.  
  728.  
  729.